@@ -2,6 +2,17 @@ Revision history for Perl extension Plack
Take a look at http://github.com/miyagawa/Plack/issues for the planned changes before 1.0 release.
+0.9943 Fri Jul 30 13:24:15 PDT 2010
+ - Updated Apache* handler so it could duck type on Loader (jnap)
+ - Added --access-log to plackup (grantm)
+ - Added support for streaming stdio in Net::FastCGI handler (chansen)
+
+0.9942 Fri Jul 23 23:42:43 PDT 2010
+ - Allow passing FCGI manager object to Handler::FCGI (confound)
+ - Call FCGI::Request::Finish() before pm_post_dispatch (confound)
+ - Moved response_cb() to Plack::Util (confound)
+ - re-enable WithLexicals now that PadWalker segfaults with 5.12 is fixed #98
+
0.9941 Thu Jul 8 18:17:30 PDT 2010
- Makes Lint not warn about ASCII-only strings with UTF8 flag because they're safe
@@ -38,4 +38,4 @@ requires:
resources:
license: http://dev.perl.org/licenses/
repository: git://github.com/miyagawa/Plack.git
-version: 0.9941
+version: 0.9943
@@ -6,7 +6,7 @@ use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.08';
+$VERSION = '0.10';
sub readme_from {
my $self = shift;
@@ -32,5 +32,5 @@ END
__END__
-#line 89
+#line 94
@@ -42,59 +42,7 @@ sub to_app {
sub response_cb {
my($self, $res, $cb) = @_;
-
- my $body_filter = sub {
- my($cb, $res) = @_;
- my $filter_cb = $cb->($res);
- # If response_cb returns a callback, treat it as a $body filter
- if (defined $filter_cb && ref $filter_cb eq 'CODE') {
- Plack::Util::header_remove($res->[1], 'Content-Length');
- if (defined $res->[2]) {
- if (ref $res->[2] eq 'ARRAY') {
- for my $line (@{$res->[2]}) {
- $line = $filter_cb->($line);
- }
- # Send EOF.
- my $eof = $filter_cb->( undef );
- push @{ $res->[2] }, $eof if defined $eof;
- } else {
- my $body = $res->[2];
- my $getline = sub { $body->getline };
- $res->[2] = Plack::Util::inline_object
- getline => sub { $filter_cb->($getline->()) },
- close => sub { $body->close };
- }
- } else {
- return $filter_cb;
- }
- }
- };
-
- if (ref $res eq 'ARRAY') {
- $body_filter->($cb, $res);
- return $res;
- } elsif (ref $res eq 'CODE') {
- return sub {
- my $respond = shift;
- my $cb = $cb; # To avoid the nested closure leak for 5.8.x
- $res->(sub {
- my $res = shift;
- my $filter_cb = $body_filter->($cb, $res);
- if ($filter_cb) {
- my $writer = $respond->($res);
- if ($writer) {
- return Plack::Util::inline_object
- write => sub { $writer->write($filter_cb->(@_)) },
- close => sub { $writer->write($filter_cb->(undef)); $writer->close };
- }
- } else {
- return $respond->($res);
- }
- });
- };
- }
-
- return $res;
+ Plack::Util::response_cb($res, $cb);
}
1;
@@ -8,6 +8,8 @@ use Scalar::Util;
my %apps; # psgi file to $app mapping
+sub new { bless {}, shift }
+
sub preload {
my $class = shift;
for my $app (@_) {
@@ -24,11 +26,14 @@ sub load_app {
}
sub handler {
- my $r = shift;
- my $apr = Apache::Request->new($r);
+ my $class = __PACKAGE__;
+ my $r = shift;
+ my $psgi = $r->dir_config('psgi_app');
+ $class->call_app($r, $class->load_app($psgi));
+}
- my $psgi = $r->dir_config('psgi_app');
- my $app = __PACKAGE__->load_app($psgi);
+sub call_app {
+ my ($class, $r, $app) = @_;
$r->subprocess_env; # let Apache create %ENV for us :)
@@ -13,6 +13,8 @@ use Scalar::Util;
my %apps; # psgi file to $app mapping
+sub new { bless {}, shift }
+
sub preload {
my $class = shift;
for my $app (@_) {
@@ -3,6 +3,7 @@ use strict;
use warnings;
use constant RUNNING_IN_HELL => $^O eq 'MSWin32';
+use Scalar::Util qw(blessed);
use Plack::Util;
use FCGI;
@@ -14,7 +15,7 @@ sub new {
$self->{keep_stderr} ||= 0;
$self->{nointr} ||= 0;
$self->{daemonize} ||= $self->{detach}; # compatibility
- $self->{nproc} ||= 1;
+ $self->{nproc} ||= 1 unless blessed $self->{manager};
$self->{pid} ||= $self->{pidfile}; # compatibility
$self->{listen} ||= [ ":$self->{port}" ] if $self->{port}; # compatibility
$self->{manager} = 'FCGI::ProcManager' unless exists $self->{manager};
@@ -55,11 +56,19 @@ sub run {
$self->daemon_fork if $self->{daemonize};
if ($self->{manager}) {
- Plack::Util::load_class($self->{manager});
- $proc_manager = $self->{manager}->new({
- n_processes => $self->{nproc},
- pid_fname => $self->{pid},
- });
+ if (blessed $self->{manager}) {
+ for (qw(nproc pid)) {
+ die "Don't use '$_' when passing in a 'manager' object"
+ if $self->{$_};
+ }
+ $proc_manager = $self->{manager};
+ } else {
+ Plack::Util::load_class($self->{manager});
+ $proc_manager = $self->{manager}->new({
+ n_processes => $self->{nproc},
+ pid_fname => $self->{pid},
+ });
+ }
# detach *before* the ProcManager inits
$self->daemon_detach if $self->{daemonize};
@@ -117,6 +126,10 @@ sub run {
die "Bad response $res";
}
+ # give pm_post_dispatch the chance to do things after the client thinks
+ # the request is done
+ $request->Finish;
+
$proc_manager && $proc_manager->pm_post_dispatch();
}
}
@@ -2,8 +2,19 @@ package Plack::Handler::Net::FastCGI;
use strict;
use Plack::Util;
use IO::Socket qw[];
+use Net::FastCGI 0.12;
use Net::FastCGI::Constant qw[:common :type :flag :role :protocol_status];
+use Net::FastCGI::IO qw[:all];
use Net::FastCGI::Protocol qw[:all];
+use Plack::TempBuffer qw[];
+
+BEGIN {
+ eval {
+ require PerlIO::code;
+ };
+ my $mode = $@ ? ">:via(@{[__PACKAGE__]})" : '>:Code';
+ *PERLIO_MODE = sub () { $mode };
+}
sub DEBUG () { 0 }
@@ -19,6 +30,12 @@ sub new {
$self;
}
+BEGIN {
+ require Socket;
+ my $HAS_AF_UNIX = eval { Socket->import('AF_UNIX'); defined(my $v = &AF_UNIX) } && !$@;
+ *HAS_AF_UNIX = sub () { $HAS_AF_UNIX };
+}
+
sub run {
my ($self, $app) = @_;
$self->{app} = $app;
@@ -47,7 +64,19 @@ sub run {
else {
(-S STDIN)
|| die "Standard input is not a socket: specify a listen location";
- $socket = \*STDIN;
+
+ my $class = 'IO::Socket::INET';
+
+ if (HAS_AF_UNIX) {
+ my $sockaddr = getsockname(*STDIN);
+ if (unpack('S', $sockaddr) == &Socket::AF_UNIX) {
+ $class = 'IO::Socket::UNIX';
+ }
+ }
+
+ $socket = $class->new;
+ $socket->fdopen(fileno(STDIN), 'w')
+ or die "$class->fdopen: $!";
$socket->autoflush(1);
}
@@ -121,19 +150,10 @@ sub _handle_response {
}
}
-sub read_record {
- @_ == 1 || die(q/Usage: read_record(io)/);
- my ($io) = @_;
- no warnings 'uninitialized';
- read($io, my $header, FCGI_HEADER_LEN) == FCGI_HEADER_LEN
- || return;
- my ($type, $request_id, $clen, $plen) = parse_header($header);
- (!$clen || read($io, my $content, $clen) == $clen)
- && (!$plen || read($io, my $padding, $plen) == $plen)
- || return;
- $content = '' if !$clen;
- return ($type, $request_id, $content);
-}
+our $STDOUT_BUFFER_SIZE = 8192;
+our $STDERR_BUFFER_SIZE = 0;
+
+use warnings FATAL => 'Net::FastCGI::IO';
sub process_connection {
my($self, $socket) = @_;
@@ -143,11 +163,10 @@ sub process_connection {
$stdout, # buffer for stdout
$stderr, # buffer for stderr
$params, # buffer for params (environ)
- $output, # buffer for output
$done, # done with connection?
$keep_conn ); # more requests on this connection?
- ($current_id, $stdin, $stdout, $stderr) = (0, '', '', '');
+ ($current_id, $stdin, $stdout, $stderr) = (0, undef, '', '');
while (!$done) {
my ($type, $request_id, $content) = read_record($socket)
@@ -163,11 +182,12 @@ sub process_connection {
my %reply = map { $_ => $self->{values}->{$_} }
grep { exists $self->{values}->{$_} }
keys %$query;
- $output = build_record(FCGI_GET_VALUES_RESULT,
+ write_record($socket, FCGI_GET_VALUES_RESULT,
FCGI_NULL_REQUEST_ID, build_params(\%reply));
}
else {
- $output = build_unknown_type_record($type);
+ write_record($socket, FCGI_UNKNOWN_TYPE,
+ FCGI_NULL_REQUEST_ID, build_unknown_type($type));
}
}
elsif ($request_id != $current_id && $type != FCGI_BEGIN_REQUEST) {
@@ -175,16 +195,18 @@ sub process_connection {
}
elsif ($type == FCGI_ABORT_REQUEST) {
$current_id = 0;
- ($stdin, $stdout, $stderr, $params) = ('', '', '', '');
+ ($stdin, $stdout, $stderr, $params) = (undef, '', '', '');
}
elsif ($type == FCGI_BEGIN_REQUEST) {
my ($role, $flags) = parse_begin_request_body($content);
if ($current_id || $role != FCGI_RESPONDER) {
- $output = build_end_request_record($request_id, 0,
- $current_id ? FCGI_CANT_MPX_CONN : FCGI_UNKNOWN_ROLE);
+ my $status = $current_id ? FCGI_CANT_MPX_CONN : FCGI_UNKNOWN_ROLE;
+ write_record($socket, FCGI_END_REQUEST, $request_id,
+ build_end_request_body(0, $status));
}
else {
$current_id = $request_id;
+ $stdin = Plack::TempBuffer->new;
$keep_conn = ($flags & FCGI_KEEP_CONN);
}
}
@@ -192,53 +214,65 @@ sub process_connection {
$params .= $content;
}
elsif ($type == FCGI_STDIN) {
- $stdin .= $content;
+ $stdin->print($content);
unless (length $content) {
- open(my $in, '<', \$stdin)
- || die(qq/Couldn't open scalar as fh: '$!'/);
-
- open(my $out, '>', \$stdout)
- || die(qq/Couldn't open scalar as fh: '$!'/);
-
- open(my $err, '>', \$stderr)
- || die(qq/Couldn't open scalar as fh: '$!'/);
+ my $in = $stdin->rewind;
+
+ my $stdout_cb = sub {
+ $stdout .= $_[0];
+ if (length $stdout >= $STDOUT_BUFFER_SIZE) {
+ write_stream($socket, FCGI_STDOUT, $current_id, $stdout, 0);
+ $stdout = '';
+ }
+ };
+
+ open(my $out, PERLIO_MODE, $stdout_cb)
+ || die(qq/Couldn't open sub as fh: $!/);
+
+ my $stderr_cb = sub {
+ $stderr .= $_[0];
+ if (length $stderr >= $STDERR_BUFFER_SIZE) {
+ write_stream($socket, FCGI_STDERR, $current_id, $stderr, 0);
+ $stderr = '';
+ }
+ };
+
+ open(my $err, PERLIO_MODE, $stderr_cb)
+ || die(qq/Couldn't open sub as fh: $!/);
$self->process_request(parse_params($params), $in, $out, $err);
- $done = 1 unless $keep_conn;
- $output = build_end_request($request_id, 0,
- FCGI_REQUEST_COMPLETE, $stdout, $stderr);
+ write_stream($socket, FCGI_STDOUT, $current_id, $stdout, 1);
+ write_stream($socket, FCGI_STDERR, $current_id, $stderr, 1);
+ write_record($socket, FCGI_END_REQUEST, $current_id,
+ build_end_request_body(0, FCGI_REQUEST_COMPLETE));
# prepare for next request
$current_id = 0;
- ($stdin, $stdout, $stderr, $params) = ('', '', '', '');
+ ($stdin, $stdout, $stderr, $params) = (undef, '', '', '');
}
}
else {
warn(qq/Received an unknown record type '$type'/);
}
+ }
+}
- if ($output) {
- print {$socket} $output
- || die(qq/Couldn't write: '$!'/);
-
- if (DEBUG) {
- while (length $output) {
- my ($type, $rid, $clen, $plen) = parse_header($output);
- my $content = substr($output, FCGI_HEADER_LEN, $clen);
- warn '> ', dump_record($type, $rid, $content), "\n";
- substr($output, 0, FCGI_HEADER_LEN + $clen + $plen, '');
- }
- }
+sub PUSHED {
+ my ($class) = @_;
+ return bless \(my $self), $class;
+}
- $output = '';
- }
- }
+sub OPEN {
+ my ($self, $sub) = @_;
+ $$self = $sub;
+}
- if (DEBUG && !$done && $!) {
- warn(qq/Request was prematurely aborted: '$!'/);
- }
+sub WRITE {
+ my ($self) = @_;
+ $$self->($_[1]);
+ return length $_[1];
}
1;
@@ -23,7 +23,7 @@ sub auto {
$class->load($backend, @args);
} catch {
warn "Autoloading '$backend' backend failed. Falling back to the Standalone. ",
- "(You might need to install Plack::Handler::$backend from CPAN)\n"
+ "(You might need to install Plack::Handler::$backend from CPAN. Caught error was: $_)\n"
if $ENV{PLACK_DEV} && $ENV{PLACK_DEV} eq 'development';
$class->load('Standalone' => @args);
};
@@ -10,7 +10,7 @@ use Plack::Util::Accessor qw( force no_print_errors );
our $StackTraceClass = "Devel::StackTrace";
# Optional since it needs PadWalker
-if ($ENV{PLACK_STACKTRACE_LEXICALS} && try { require Devel::StackTrace::WithLexicals; 1 }) {
+if (try { require Devel::StackTrace::WithLexicals; 1 }) {
$StackTraceClass = "Devel::StackTrace::WithLexicals";
}
@@ -2,7 +2,7 @@ package Plack::Request;
use strict;
use warnings;
use 5.008_001;
-our $VERSION = '0.9941';
+our $VERSION = '0.9943';
$VERSION = eval $VERSION;
use HTTP::Headers;
@@ -1,7 +1,7 @@
package Plack::Response;
use strict;
use warnings;
-our $VERSION = '0.9941';
+our $VERSION = '0.9943';
$VERSION = eval $VERSION;
use Plack::Util::Accessor qw(body status);
@@ -50,6 +50,7 @@ sub parse_options {
'r|reload' => sub { $self->{loader} = "Restarter" },
'R|Reload=s' => sub { $self->{loader} = "Restarter"; $self->loader->watch(split ",", $_[1]) },
'L|loader=s' => \$self->{loader},
+ "access-log=s" => \$self->{access_log},
"h|help" => \$self->{help},
"v|version" => \$self->{version},
);
@@ -191,7 +192,7 @@ sub prepare_devel {
$app = $self->apply_middleware($app, 'Lint');
$app = $self->apply_middleware($app, 'StackTrace');
- unless ($ENV{GATEWAY_INTERFACE}) {
+ if (!$ENV{GATEWAY_INTERFACE} and !$self->{access_log}) {
$app = $self->apply_middleware($app, 'AccessLog', logger => sub { print STDERR @_ });
}
@@ -241,6 +242,13 @@ sub run {
$app = $self->prepare_devel($app);
}
+ if ($self->{access_log}) {
+ open my $logfh, ">>", $self->{access_log}
+ or die "open($self->{access_log}): $!";
+ $logfh->autoflush(1);
+ $app = $self->apply_middleware($app, 'AccessLog', logger => sub { $logfh->print( @_ ) });
+ }
+
my $loader = $self->loader;
$loader->preload_app($app);
@@ -1,6 +1,6 @@
package Plack::Server::ServerSimple;
use strict;
-our $VERSION = '0.9941';
+our $VERSION = '0.9943';
$VERSION = eval $VERSION;
use parent qw(Plack::Handler::HTTP::Server::Simple);
@@ -236,6 +236,63 @@ sub inline_object {
bless {%args}, 'Plack::Util::Prototype';
}
+sub response_cb {
+ my($res, $cb) = @_;
+
+ my $body_filter = sub {
+ my($cb, $res) = @_;
+ my $filter_cb = $cb->($res);
+ # If response_cb returns a callback, treat it as a $body filter
+ if (defined $filter_cb && ref $filter_cb eq 'CODE') {
+ Plack::Util::header_remove($res->[1], 'Content-Length');
+ if (defined $res->[2]) {
+ if (ref $res->[2] eq 'ARRAY') {
+ for my $line (@{$res->[2]}) {
+ $line = $filter_cb->($line);
+ }
+ # Send EOF.
+ my $eof = $filter_cb->( undef );
+ push @{ $res->[2] }, $eof if defined $eof;
+ } else {
+ my $body = $res->[2];
+ my $getline = sub { $body->getline };
+ $res->[2] = Plack::Util::inline_object
+ getline => sub { $filter_cb->($getline->()) },
+ close => sub { $body->close };
+ }
+ } else {
+ return $filter_cb;
+ }
+ }
+ };
+
+ if (ref $res eq 'ARRAY') {
+ $body_filter->($cb, $res);
+ return $res;
+ } elsif (ref $res eq 'CODE') {
+ return sub {
+ my $respond = shift;
+ my $cb = $cb; # To avoid the nested closure leak for 5.8.x
+ $res->(sub {
+ my $res = shift;
+ my $filter_cb = $body_filter->($cb, $res);
+ if ($filter_cb) {
+ my $writer = $respond->($res);
+ if ($writer) {
+ return Plack::Util::inline_object
+ write => sub { $writer->write($filter_cb->(@_)) },
+ close => sub { $writer->write($filter_cb->(undef)); $writer->close };
+ }
+ } else {
+ return $respond->($res);
+ }
+ });
+ };
+ }
+
+ return $res;
+}
+
package Plack::Util::Prototype;
our $AUTOLOAD;
@@ -3,7 +3,7 @@ package Plack;
use strict;
use warnings;
use 5.008_001;
-our $VERSION = '0.9941';
+our $VERSION = '0.9943';
$VERSION = eval $VERSION;
1;
@@ -163,6 +163,11 @@ I<Shotgun>.
See L<Plack::Loader::Delayed> and L<Plack::Loader::Shotgun> when to
use those loader types.
+=item --access-log
+
+Specify the pathname of a file where the access log should be written.
+By default, in the development environment access logs will go to STDERR.
+
=back
Other options that starts with C<--> are passed through to the backend
@@ -18,6 +18,16 @@ test_lighty_external(
}
);
+{
+ package Plack::Handler::FCGI::Manager;
+ use parent qw(FCGI::ProcManager);
+ sub pm_post_dispatch {
+ my $self = shift;
+ ${ $self->{dispatched} }++;
+ $self->SUPER::pm_post_dispatch(@_);
+ }
+}
+
sub run_server_cb {
my $needs_fix = shift;
@@ -30,13 +40,19 @@ sub run_server_cb {
$| = 0; # Test::Builder autoflushes this. reset!
+ my $d;
+ my $manager = Plack::Handler::FCGI::Manager->new({
+ dispatched => \$d,
+ });
+
my $server = Plack::Handler::FCGI->new(
host => '127.0.0.1',
port => $port,
- manager => '',
+ manager => $manager,
keep_stderr => 1,
);
$server->run($app);
+ ok($d > 0, "FCGI manager object state updated");
};
}